home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
system
/
pgraf130.zip
/
PASCAL.ZIP
/
DEMO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-10-14
|
7KB
|
232 lines
program PGraph_Demo;
{*******************************************************************
* *
* 'Printer Graphics Interface' Demonstration Program *
* *
* This program demonstrates how to use various functions *
* available in the PGRAPH library. *
* *
* Author: F van der Hulst *
* *
* Revisions: *
* 27 March 1991: Initial release (Turbo C v2.0 only) *
* 07 April 1991: Ported to MicroSoft C v5.1 *
* 15 October 1991: Rewritten in Turbo-Pascal *
* *
*******************************************************************}
uses demo_sub, demo_scr, pgraph, pgrafbuf, various;
const MAX_WIDTH = 801; { Maximum width of any PGRAPH viewport defined in the program }
type page_size_type = record
x, y: integer;
end;
const page_size: array[1..5] of page_size_type = (
{ Page sizes in 1/100 of an inch available on various printers }
(x:800; y:1100), { STAR }
(x:780; y:1088), { LaserJet }
(x:800; y:1100), { Epson LX400 }
(x:800; y:1100), { USER1 }
(x:800; y:1100) ); { USER2 }
{*******************************************************************
Process command line arguments. }
procedure strupr(var str: string);
var i: integer;
begin
for i := 1 to length(str) do str[i] := upcase(str[i]);
end;
procedure get_args(var driver: integer;
var mode: integer;
var dev_name: string;
var demos: string);
var i, code, low, high: integer;
var param: string;
begin
for i := 1 to paramcount do begin
param := paramstr(i);
strupr(param);
if (param[1] <> '/') and (param[1] <> '-') then begin
writeln('Invalid command line switch:', param);
writeln('(Must start with "-" or "/")');
writeln('Use /? to get help');
halt(1);
end;
if (param[2] = '?') or (param[2] = 'H') then begin
writeln('Command syntax:');
writeln(paramstr(0), '[/O=outputdevice][/P=printer][/M=mode][/D=demos]');
writeln;
writeln('outputdevice may be PRN, or a filename');
writeln('printer may be STAR, LASERJET, LX-400, USER1, or USER2');
writeln(' If you use LX-400, USER1, USER2, the corresponding .PGI file');
writeln(' must be in the current directory');
writeln('mode is an integer in the range 0 to the maximum mode for the selected printer');
writeln('demos is a series of letters (A-L), identifying which demos to print');
writeln;
writeln('Default values are PRN and STAR, and a mode better than 120dpi)');
writeln;
halt(0);
end;
if (param[3] <> '=') then begin
writeln('Invalid command line switch: ', param);
writeln('(Must be /', param[2], '=VALUE)');
writeln('Use /? to get help\n');
halt(1);
end;
case param[2] of
'O': begin
delete(param, 1, 3);
dev_name := param;
end;
'P': begin
delete(param, 1, 3);
if param = 'STAR' then driver := STAR
else if param = 'LX-400' then driver := LX400
else if param = 'LASERJET' then driver := LASERJET
else if param = 'USER1' then driver := USER1
else if param = 'USER2' then driver := USER2
else begin
writeln('Unknown printer type: ', param);
writeln('Use /? to get help');
halt(1);
end;
end;
'M': begin
delete(param, 1, 3);
val(param, mode, code);
p_getmoderange(driver, low, high);
if (mode > high) or (mode < low) then begin
writeln('Invalid mode: ', mode, ' (should be ', low, ' - ', high);
halt(1);
end;
end;
'D': begin
delete(param, 1, 3);
demos := param;
end;
else begin
writeln('Invalid command line switch: ', param);
writeln('(Must be /D, /O, /P, or /M)');
writeln('Use /? to get help');
halt(1);
end;
end;
end;
end;
{*******************************************************************
Find the best mode (the worst X resolution that will display
MAX_WIDTH bits) for the selected printer. }
function best_mode: integer;
var i: integer;
var xres, yres, best_x, best_y: integer;
var mode: integer;
begin
mode := 0;
best_y := 1000;
best_x := 1000;
for i := 0 to p_getmaxmode do begin
p_setgraphmode(i);
p_getresolution(xres, yres);
if longint(xres) * page_width div 100 >= MAX_WIDTH+7
then if (xres < best_x) or ((xres = best_x) and (yres < best_y)) then begin
best_y := yres;
best_x := xres;
mode := i;
end;
end;
best_mode := mode;
end;
var driver, mode, dummy_mode, errorcode: integer;
var xres, yres: integer;
var filename: string;
var selection: string;
var BGI_path: string;
const printer_ID: array[1..5] of string = ('STAR', 'LASERJET', 'LX-400', 'USER1', 'USER2' );
begin { Main block }
driver := 1;
mode := -1;
filename := 'PRN';
selection := 'ABCDEFGHIJKL';
BGI_path := '';
screen_echo := false;
init_buffering;
__p_putpixel_screen := nil;
errorcode := p_registerbgidriver(@LASERJET_DRIVER);
if errorcode < 0 then begin
writeln('Couldn''t register LASERJET PGI driver: ', errorcode);
halt(2);
end;
errorcode := p_registerfarbgidriver(@STAR_DRIVER);
if errorcode < 0 then begin
writeln('Couldn''t register STAR PGI driver: ', errorcode);
halt(2);
end;
get_args(driver, mode, filename, selection);
writeln('Selection is:');
writeln(' Output to ', filename);
writeln(' Printer type is ', printer_ID[driver]);
writeln(' Demo selection is ', selection);
writeln;
{ REMOVED TO ALLOW RUNNING FROM BATCH FILE
write('Is this OK (Y/N)? ');
if ((getch & 0x0df) <> 'Y') halt(1);
write('\n\n');
}
assign(prn, filename);
rewrite(prn);
if mode = -1
then dummy_mode := 0
else dummy_mode := mode;
p_initgraph(driver, dummy_mode, BGI_path);
errorcode := p_graphresult; { preserve error return }
if (errorcode <> 0) then begin { error? }
writeln('Graphics error: ', errorcode {grapherrormsg(errorcode)});
halt(1);
end;
page_height := page_size[driver].y;
page_width := page_size[driver].x;
if (mode < 0) or (mode > p_getmaxmode) then mode := best_mode;
p_setgraphmode(mode);
p_getresolution(xres, yres);
writeln('Currently set to mode ', mode, ' (', xres, ' by ', yres, 'dpi).');
if pos('A', selection) > 0 then shapes_demo;
if pos('B', selection) > 0 then stroked_fonts_demo;
if pos('C', selection) > 0 then default_font_demo;
if pos('D', selection) > 0 then horiz_text_demo;
if pos('E', selection) > 0 then vert_text_demo;
if pos('F', selection) > 0 then text_scaling_demo;
if pos('G', selection) > 0 then shape_fill_demo;
if pos('H', selection) > 0 then flood_fill_demo;
if pos('I', selection) > 0 then lines_demo;
if pos('J', selection) > 0 then pie_demo;
if pos('K', selection) > 0 then image_demo;
if pos('L', selection) > 0 then view_demo;
writeln('Closing PGRAPH down.');
p_closegraph;
writeln('Closing output file.');
close(prn);
end.